###############################################################################
# RANK-FORMATER FUNCTION
#
# Function forms coalitions after elections
#
# Coalition formation follows this logic:
# - rank coalitions by party utility
# - weight party ranks by election result
# - sum weighted party ranks for coalition sums 
# - rank coalition sums
# - dictator puts suggestions to vote (in order of ranked coaltion sums)
# - member parties vote on it vs. status quo
#
#
# Last edited: 14 June 2013 by Roni 
###############################################################################

#Inputs:
#allc: combinations X parties matrix of all potential coalitions indicating party membership
#elections: vector of election results
#partydim1: vector of party positions dim1
#partydim2: vector of party positions dim2
#alpha: vector of relative office proneness
#cur.util: vector of status quo utility with old government

#for debugging: takes inputs from sim.function and adjusts them.
## Apartydim1 <- partydim1
## Apartydim2 <- partydim2
## Aallc <- allc
## Aelections <- elections
## Agov <- gov

## partydim1 <- Apartydim1
## partydim2 <- Apartydim2
## allc <- Aallc
## elections <- Aelections
## gov <- Agov

## partydim1 <- partydim1[r,]
## partydim2 <- partydim2[r,]
## elections <- elections[r,]
## gov <- gov[(r-1),]




rank.formater <- function(allc, elections, partydim1, partydim2, alpha, cur.util, discount, gov,
                          pprefdim1, pprefdim2, old.govdim1, old.govdim2, old.govseats, cur.gov) {
 parties <- length(elections)
 #these need to be computed again because allc is now allc.real
 seatsc <- t(apply(allc, 1, product, t(elections))) #seats parties contribute to coalition
 sumseats <- rowSums(seatsc)
 
 #I drop the first government (which has no member parties)
 utility <- matrix(0, dim(allc)[1], parties)

 weights <- seatsc/sumseats
 govpos <-cbind(weights%*%as.matrix(partydim1),
               weights%*%as.matrix(partydim2))  
 utilityP <- t(apply(govpos, 1, utilizerP.gov.given, pprefdim1=pprefdim1, pprefdim2=pprefdim2))
 utilityP[is.na(utilityP)] <- 0 #happens if parties have no seats

 ## utilityP <- rescale(utilityP) #no longer needed
 
 utilityS <- seater(seatsc, sumseats) #get seat share of party in coalition
 utilityS[is.na(utilityS)] <- 0 #correct for cases with no seats in government 

 utility <- utilizer(alpha, utilityP, utilityS) #compute utility (incl. alpha)

#find parties in favor of candidate government
in.favor <- ifelse(t(apply(utility, 1, compare, (cur.util*(1-discount)))),1,0)
member.in.favor <- ifelse(as.matrix(allc)==1, in.favor, NaN)
membership.agrees <- ifelse(rowSums(member.in.favor, na.rm=TRUE)==rowSums(allc),1,0)

#is candidate government supported by majority in parliament?
majority.agrees <- ifelse(rowSums(t(elections*t(in.favor)))>=((sum(elections)/2)+1),1,0)

#get a coalition-level indicator that specifies if all parties in coalition have at least one seat.
party.in.parliament <- apply(allc, 1, check.in.parliament, elections=elections) 
 
#has government all? 1)membership and 2) parliament support and all 3) parties have seats?
government.viable <- membership.agrees*majority.agrees*party.in.parliament

if (sum(government.viable)==0) { #check if a government is formed
  if (length(gov)==0) { #if first round and no previous government available, install the current one but discount
     candidate <- which(apply(allc, 1, identical, cur.gov)==TRUE)
     govseats <- as.matrix(seater(seatsc[candidate,], sumseats[candidate])) 
     govdim1 <- as.numeric(t(govseats)%*%as.matrix(partydim1))
     govdim2 <- as.numeric(t(govseats)%*%as.matrix(partydim2))
     coalition <- c(candidate, govdim1, govdim2,
                    utility[candidate,]*discount, utilityS[candidate,], govseats, 1)
  } else {
    #if not, install caretaker with less utility (same position, same seats but discounted)
     candidate <- which(apply(allc, 1, identical, gov)==TRUE)
     govseats <- old.govseats
     govdim1 <- old.govdim1
     govdim2 <- old.govdim2
     coalition <- c(candidate, govdim1, govdim2,
                  (utility[candidate,]*discount), utilityS[candidate,], govseats, 1)
 }
} else {
    #get order in which governments are suggested 
    rankParty <- apply(utility, 2, rank, ties.method="min")
    rankPartyW <- t(elections * t(rankParty)) #ranks weighted by votes
    #ranks of weighted ranks
    rankCoalition <- rank(rowSums(rankPartyW), ties.method="min")
 if (sum(rankCoalition==max(rankCoalition))==1) { #if there exists a tie
    candidate <- which.max(rankCoalition*government.viable)
 } else {
   MeanrankParty <- apply(utility, 2, rank, ties.method="average") 
   MeanrankPartyW <- t(elections * t(MeanrankParty)) 
   MeanrankCoalition <- rank(rowSums(MeanrankPartyW), ties.method="min")
   candidate <- which.is.max(MeanrankCoalition*government.viable)
 }
   govseats <- as.matrix(seater(seatsc[candidate,], sumseats[candidate]))
   govdim1 <- as.numeric(t(govseats)%*%as.matrix(partydim1))
   govdim2 <- as.numeric(t(govseats)%*%as.matrix(partydim2))
   coalition <- c(candidate, govdim1, govdim2,
                  utility[candidate,], utilityS[candidate,], govseats, 0)
}

 
 


 
 names(coalition) <- c("winner", "govdim1", "govdim2", "utility", "govseats")
 names(coalition)[(4+parties)] <- "bargpow"
 names(coalition)[(4+(2*parties))] <- "govseats"
 names(coalition)[length(coalition)] <- "caretaker"
 #returns utility and not seat utility!
 return(coalition)
} #end rank.formater
rank.formater <- cmpfun(rank.formater)

initial.utility <- function(vprefdim1, vprefdim2, gov, partydim1, partydim2, alpha,
                            pprefdim1, pprefdim2) {
 #Voting
 parties <- length(gov)

 distances  <- t(apply(cbind(vprefdim1, vprefdim2), 1, euclidean.distancer, partydim1,
                partydim2))
 
 vote <- apply(distances, 1, voter)
 elections <- tabulate(vote, parties)

 #Find utilities
 seatsc <- gov*elections # #seats parties contribute to coalition
 sumseats <- sum(seatsc) # #seats coalition has
 utilityP <- c()
    for(p in 1:parties){ #loop over parties
     utilityP[p] <- utilizerP(pprefdim1[p], #get policy payoffs
                                seatsc,
                                sumseats,
                                partydim1,
                                pprefdim1[p],
                                partydim2)
   }

  ## utilityP <- utilityP*(-1) #utilityP is originally distance not utility

  #utilityP <- rescale(utilityP) no longer needed
  
  utilityS <- seater(seatsc, sumseats) #get seat share of party in coalition
 
  utility <- utilizer(alpha, utilityP, utilityS) #compute utility
  return(utility) 
} #end rank.formater

